home *** CD-ROM | disk | FTP | other *** search
/ Fritz: All Fritz / All Fritz.zip / All Fritz / FILES / PROGMISC / FORTRAN1.LZH / GETLIN.FOR < prev    next >
Text File  |  1988-02-08  |  4KB  |  137 lines
  1.       SUBROUTINE GETLIN ( NREAD, ERROR, LINE, LEN )
  2. C*
  3. C*                  *******************************
  4. C*                  *******************************
  5. C*                  **                           **
  6. C*                  **          GETLIN           **
  7. C*                  **                           **
  8. C*                  *******************************
  9. C*                  *******************************
  10. C*
  11. C*     SUBPROGRAM :
  12. C*          GET LINE
  13. C*
  14. C*     AUTHOR :
  15. C*          ART RAGOSTA
  16. C*          MS 207-5
  17. C*          AMES RESEARCH CENTER
  18. C*          MOFFETT FIELD, CA  94035
  19. C*          (415) 694-5578
  20. C*
  21. C*     PURPOSE :
  22. C*          READ ONE OR MORE LINES OF INPUT, CAPITALIZE, DELETE COMMENTS
  23. C*          AND CONTINUE READING IF CONTINUATION SPECIFIED (...).
  24. C*
  25. C*     INPUT ARGUMENTS :
  26. C*          NREAD - UNIT FROM WHICH TO READ INPUT
  27. C*
  28. C*     OUTPUT ARGUMENTS :
  29. C*          ERROR - AN ERROR WAS ENCOUNTERED DURING INPUT, OR
  30. C*                   INPUT WAS TOO LONG.
  31. C*          LINE  - THE CHARACTER*500 VARIABLE CONTAINING THE LINE.
  32. C*          LEN   - NUMBER OF CHARACTERS RETURNED IN LINE.
  33. C*
  34. C*     INTERNAL WORK AREAS :
  35. C*          STRING - 80 CHARACTER BUFFER FOR READS FROM TERMINAL.
  36. C*
  37. C*     COMMON BLOCKS :
  38. C*          NONE
  39. C*
  40. C*     FILE REFERENCES :
  41. C*          NREAD
  42. C*
  43. C*     DATA BASE ACCESS :
  44. C*          NONE
  45. C*
  46. C*     SUBPROGRAM REFERENCES :
  47. C*          CAPS
  48. C*
  49. C*     ERROR PROCESSING :
  50. C*          THE LINE LENGTH IS NOT ALLOWED TO EXCEED 500 CHARACTERS.
  51. C*
  52. C*     TRANSPORTABILITY LIMITATIONS :
  53. C*          NONE
  54. C*
  55. C*     ASSUMPTIONS AND RESTRICTIONS :
  56. C*          NONE
  57. C*
  58. C*     LANGUAGE AND COMPILER :
  59. C*          ANSI FORTRAN 77
  60. C*
  61. C*     VERSION AND DATE :
  62. C*          VERSION I.0      3-OCT-84
  63. C*
  64. C*     CHANGE HISTORY :
  65. C*           3-OCT-84    INITIAL VERSION
  66. C*
  67. C***********************************************************************
  68. C*
  69.       CHARACTER*500 LINE
  70.       CHARACTER*80 STRING
  71.       LOGICAL ERROR, CONT
  72. C
  73.       ERROR = .FALSE.
  74.       LEN  = 1
  75.       LINE = ' '
  76.       CONT = .TRUE.
  77. C
  78. C --- WHILE CONTINUE FLAG IS SET DO...
  79. C
  80. 10    IF ( CONT ) THEN
  81.          READ ( NREAD, 900 )STRING
  82.          CALL CAPS ( STRING )
  83.          DO 20 J = 1,80
  84. C
  85. C ------ EXCLAMATION MEANS REST OF LINE IS COMMENTARY
  86. C
  87.             IF ( STRING(J:J) .EQ. '!' )GO TO 30
  88.             LINE(LEN:LEN) = STRING(J:J)
  89.             LEN = LEN + 1
  90.             IF (LEN .GT. 500) THEN
  91.                ERROR = .TRUE.
  92.                RETURN
  93.             ENDIF
  94. 20          CONTINUE
  95. C
  96. C --- NOW REMOVE ANY EXCESSIVE TRAILING BLANKS.
  97. C
  98. 30       IF ( LINE(LEN:LEN) .EQ. ' ' ) THEN
  99.             LEN = LEN - 1
  100.             IF ( LEN .GT. 1 ) GO TO 30
  101.          ENDIF
  102.          CONT = .FALSE.
  103. C
  104. C --- CHECK FOR CONTINUATION ( ELLIPSES ).
  105. C
  106.          IF ( LINE(LEN:LEN) .EQ. '.' ) THEN
  107.             I1 = LEN - 1
  108.             IF ( LINE(I1:I1) .EQ. '.' ) THEN
  109. C
  110. C --- ELLIPSES FOUND, REMOVE IT AND SET CONTINUATION FLAG
  111. C
  112.                CONT = .TRUE.
  113. 40             LEN = LEN - 1
  114.                IF ((LINE(LEN:LEN) .EQ. '.') .AND. (LEN .GT. 1))
  115.      $          GO TO 40
  116.             ENDIF
  117. C
  118. C --- ADD ONE SPACE AT THE END OF THE LINE
  119. C
  120.             IF (LEN .LT. 499) THEN
  121.                LEN = LEN + 1
  122.                LINE(LEN:LEN) = ' '
  123.                LEN = LEN + 1
  124.             ENDIF
  125.          ENDIF
  126.          GO TO 10
  127.       ENDIF
  128. C
  129. C --- END OF DO WHILE
  130. C
  131.       RETURN
  132. 900   FORMAT ( A80 )
  133.       END
  134. C
  135. C---END GETLIN
  136. C
  137.